home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 25 / CU Amiga Magazine's Super CD-ROM 25 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-08].iso / CUCD / Programming / GMS / GMSDev / Source / E / Demos / Kohonen.e < prev    next >
Encoding:
Text File  |  1998-05-14  |  4.6 KB  |  167 lines
  1. /* Kohonen Feature Maps in E, implemented with integers
  2. **
  3. ** Kohonen feature maps are special types of neural nets, and
  4. ** this implementation shows graphically how they organise themselves
  5. ** after a while.
  6. **
  7. ** [This demo from the AmigaE archives has been converted to work with GMS.
  8. ** It is at about 33% faster than the original intuition version.]
  9. */
  10.  
  11. CONST ONE     = 1024*16,   KSHIFT = 14,      KSIZE  = 7,
  12.       MAXTIME = 500,       DELAY  = 0,       YOFF   = 20
  13. CONST KSTEP   = ONE/KSIZE, KNODES = KSIZE+1, ARSIZE = KSIZE*KSIZE,
  14.       XRED    = 64,        YRED   = 128,     XOFF   = 10
  15.  
  16. MODULE 'gms/dpkernel','gms/dpkernel/dpkernel','gms/graphics/pictures'
  17. MODULE 'gms/files/files','gms/screens','gms/system/register','gms/system/modules'
  18. MODULE 'gms/input/joydata','gms/graphics/screens','gms/graphics/blitter'
  19. MODULE 'gms/blitter'
  20.  
  21. /*=========================================================================*/
  22.  
  23. PROC main()
  24.  DEF screen    = NIL:PTR TO screen,
  25.      scrmodule = NIL:PTR TO module,
  26.      bltmodule = NIL:PTR TO module,
  27.      map, t, input, x, y
  28.  
  29.  IF dpkbase := OpenLibrary('GMS:libs/dpkernel.library',0)
  30.   IF (scrmodule := Init([TAGS_MODULE,NIL,
  31.       MODA_NUMBER,    MOD_SCREENS,
  32.       MODA_TABLETYPE, JMP_AMIGAE,
  33.       TAGEND], NIL))
  34.       scrbase := scrmodule.modbase
  35.  
  36.   IF (bltmodule := Init([TAGS_MODULE,NIL,
  37.       MODA_NUMBER,    MOD_BLITTER,
  38.       MODA_TABLETYPE, JMP_AMIGAE,
  39.       TAGEND], NIL))
  40.       bltbase := bltmodule.modbase
  41.  
  42.     IF (screen := Init([TAGS_SCREEN,NIL,
  43.        GSA_Attrib,    SCR_DBLBUFFER OR SCR_CENTRE,
  44.        GSA_ScrMode,   SM_HIRES,
  45.        GSA_Width,     320,
  46.        GSA_Height,    256,
  47.          GSA_BitmapTags, NIL,
  48.          BMA_Planes,     2,
  49.          BMA_Palette,    [ PALETTE_ARRAY, 2, $000000, $f0f0f0 ],
  50.          TAGEND,         NIL,
  51.        TAGEND],NIL))
  52.  
  53.         Show(screen)
  54.  
  55.         map := kohonen_init(KSIZE,KSIZE,2)
  56.  
  57.         FOR t := 0 TO MAXTIME-1
  58.           input := [Rnd(KNODES)*KSTEP,Rnd(KNODES)*KSTEP]
  59.           x,y   := kohonen_BMU(map,input)
  60.           kohonen_plot(map,screen,x,y)
  61.           kohonen_learn(map,x,y,MAXTIME-t*(ONE/MAXTIME),input)
  62.         ENDFOR
  63.  
  64.         WaitTime(100)
  65.  
  66.     Free(screen)
  67.     ENDIF
  68.    Free(bltmodule)
  69.    ENDIF
  70.   Free(scrmodule)
  71.   ENDIF
  72.  CloseDPK()
  73.  ENDIF
  74. ENDPROC
  75.  
  76. /*=========================================================================*/
  77.  
  78. PROC kohonen_plot(map,screen:PTR TO screen,bx,by)
  79. DEF x,y,n:PTR TO LONG,cx,cy,i,ii,sx[ARSIZE]:ARRAY OF LONG
  80. DEF sy[ARSIZE]:ARRAY OF LONG
  81.  
  82.   Clear(screen.bitmap)
  83.   FOR x:=0 TO KSIZE-1
  84.     FOR y:=0 TO KSIZE-1
  85.       n := kohonen_node(map,x,y)
  86.       i := x*KSIZE+y
  87.       ii := x-1*KSIZE+y
  88.       sx[i] := cx := s(n[0]/XRED+XOFF)
  89.       sy[i] := cy := s(n[1]/YRED+YOFF)
  90.       IF x>0 THEN DrawLine(screen.bitmap,sx[ii],sy[ii],cx,cy,1,$FFFFFFFF)
  91.       IF y>0 THEN DrawLine(screen.bitmap,sx[i-1],sy[i-1],cx,cy,1,$FFFFFFFF)
  92.     ENDFOR
  93.   ENDFOR
  94.  
  95.   n := kohonen_node(map,bx,by)
  96.   DrawPixel(screen.bitmap,s(n[0]/XRED+XOFF),s(n[1]/YRED+YOFF),1)
  97.   WaitAVBL()
  98.   SwapBuffers(screen)
  99.   screen.bitmap.data := screen.memptr2
  100. ENDPROC
  101.  
  102. /*=========================================================================*/
  103.  
  104. PROC s(c) IS IF c<0 THEN 0 ELSE IF c>1000 THEN 1000 ELSE c
  105.  
  106. /*=========================================================================*/
  107.  
  108. PROC kohonen_BMU(map,i:PTR TO LONG)
  109.   DEF x,y,act,bestx,besty,bestact=$FFFFFFF,n:PTR TO LONG,len,a
  110.  
  111.   len:=ListLen(i)-1
  112.   FOR x:=0 TO KSIZE-1
  113.     FOR y:=0 TO KSIZE-1
  114.       n:=kohonen_node(map,x,y)
  115.       act:=0
  116.       FOR a:=0 TO len DO act:=Abs(n[a]-i[a])+act
  117.       IF act<bestact
  118.          bestx := x
  119.          besty := y
  120.          bestact := act
  121.       ENDIF
  122.     ENDFOR
  123.   ENDFOR
  124.  
  125. ENDPROC bestx,besty
  126.  
  127. /*=========================================================================*/
  128.  
  129. PROC kohonen_learn(m,bx,by,t,i:PTR TO LONG)
  130.   DEF x,y,n:PTR TO LONG,d,a,len,bell:PTR TO LONG
  131.  
  132.   bell:=[50,49,47,40,25,13,10,8,6,5,4,3,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]
  133.   len:=ListLen(i)-1
  134.  
  135.   FOR x:=0 TO KSIZE-1
  136.     FOR y:=0 TO KSIZE-1
  137.       n:=kohonen_node(m,x,y)
  138.       d:=t*bell[Abs(bx-x)+Abs(by-y)]/50      -> cityblock
  139.       IF d>0
  140.         FOR a:=0 TO len DO n[a]:=n[a]+Shr(i[a]-n[a]*d,KSHIFT)
  141.       ENDIF
  142.     ENDFOR
  143.   ENDFOR
  144. ENDPROC
  145.  
  146. /*=========================================================================*/
  147.  
  148. PROC kohonen_node(map:PTR TO LONG,x,y)
  149.   DEF r:PTR TO LONG
  150.   r:=map[x]
  151. ENDPROC r[y]
  152.  
  153. /*=========================================================================*/
  154.  
  155. PROC kohonen_init(numx,numy,numw)
  156. DEF m:PTR TO LONG,r:PTR TO LONG,w:PTR TO LONG,a,b,c
  157.   NEW m[numx]
  158.   FOR a:=0 TO numx-1
  159.     m[a]:=NEW r[numy]
  160.     FOR b:=0 TO numy-1
  161.       r[b]:=NEW w[numw]
  162.       FOR c:=0 TO numw-1 DO w[c]:=ONE/2
  163.     ENDFOR
  164.   ENDFOR
  165. ENDPROC m
  166.  
  167.